Here’s our starting notebook analysis of the Health Canada nutrient dataset
library(ggplot2)
library(dplyr)
library(plotly)
# What's in this Rdata file: save(ca_conversion_factor, ca_food_choices, ca_food_group, ca_food_name, ca_food_source, ca_measure_name, ca_nutrient_amount, ca_nutrient_name, ca_nutrient_source, ca_refuse_amount, ca_refuse_name, ca_yield_amount, ca_yield_name, daily_value, file = "nutrient_data.Rdata")
load("../data/nutrient_data.Rdata")
We’ve got our data loaded, now what do we want to know?
ca_food_group
head(ca_food_name)
NA
What do my daily coffee macros look like?
#I'll need the ingredients, the amounts, and their respective macronutrients
measure_df <- ca_food_name %>%
filter(FoodDescription == "Coffee, brewed, prepared with tap water") %>%
select(FoodID) %>%
left_join(ca_conversion_factor) %>%
left_join(ca_measure_name) %>%
select(numeric, units, description, ConversionFactorValue, MeasureID, FoodID)
measure_food_df <- measure_df %>%
filter(numeric == 250) %>%
left_join(ca_nutrient_amount) %>%
left_join(ca_nutrient_name) %>%
mutate(NutrientName = tolower(NutrientName)) %>%
mutate(NutrientValue = NutrientValue * ConversionFactorValue * 250 / numeric) %>%
select(NutrientName, NutrientValue, NutrientID, NutrientUnit, ConversionFactorValue, FoodID) %>%
group_by(NutrientName) %>%
summarize(Value = round(sum(NutrientValue, na.rm = T), digits = 2),
Unit = NutrientUnit,
NutrientID = NutrientID)
select_nutrients <- c("calcium", "carbohydrate, total (by difference)", "cholesterol", "energy (kilocalories)", "fat (total lipids)", "fatty acids, saturated, total", "fatty acids, trans, total", "fibre, total dietary", "iron", "protein", "retinol activity equivalents", "sodium", "sugars, total", "vitamin c")
macro_df <- measure_food_df %>% filter(NutrientName %in% select_nutrients) %>%
select(NutrientName, NutrientID, Value, Unit) %>%
arrange(-Value)
scaled_macro_df <- daily_value %>%
left_join(macro_df) %>%
filter(Group == "macronutrients") %>%
mutate(Scaled_dv = round(Value/DV, digits = 3) * 100) %>%
na.omit()
#look at our dataframe
scaled_macro_df
#get rid of funky unit name that causes issues
scaled_macro_df[scaled_macro_df$Unit == "\xb5g", "Unit"] <- "g"
nutrient_plot <- ggplot(scaled_macro_df) +
geom_bar(stat = "identity", aes(x = reorder(NutrientName, Scaled_dv), Scaled_dv)) +
xlab("Nutrient name") +
ylab("% Daily value") +
coord_flip()
nutrient_plot

#interactive version of the plot with the value as a hovering tooltip
ggplotly(nutrient_plot, tooltip = "y")
NA
What does my daily coffee mineral intake look like?
scaled_mineral_df <- daily_value %>%
left_join(macro_df) %>%
filter(Group == "mineral") %>%
mutate(Scaled_dv = round(Value/DV, digits = 3) * 100) %>%
na.omit()
#look at our dataframe
scaled_mineral_df
#get rid of funky unit name that causes issues
scaled_mineral_df[scaled_mineral_df$Unit == "\xb5g", "Unit"] <- "g"
mineral_plot <- ggplot(scaled_mineral_df) +
geom_bar(stat = "identity", aes(x = reorder(NutrientName, Scaled_dv), Scaled_dv)) +
xlab("Mineral name") +
ylab("% Daily value") +
coord_flip()
mineral_plot

#interactive version of the plot with the value as a hovering tooltip
ggplotly(mineral_plot, tooltip = "y")
NA
All right, so we’ve used the Health Canada dataset to produce some tables and plots for nutrient info pertaining to a serving of coffee. The code works, but are we really just going to copy and paste the it for every food ingredient we want to know about?
Maybe we could wrap our code in a function that takes the food name as input and returns all of our tables and figures. What do we do if we want to add multiple ingredients together, though? It’s clear that our notebook approach to this dataset doesn’t really scale well. This is where Shiny comes in to play. We can replace the hard-coded ingredient text that with an active input that updates our plots and tables when we change our ingredient.
LS0tCnRpdGxlOiAiTnV0cmllbnQgZGF0YSIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKIyBIZXJlJ3Mgb3VyIHN0YXJ0aW5nIG5vdGVib29rIGFuYWx5c2lzIG9mIHRoZSBIZWFsdGggQ2FuYWRhIG51dHJpZW50IGRhdGFzZXQKCmBgYHtyIGxpYnJhcmllcyBhbmQgZGF0YSBpbXBvcnRpbmcsIG1lc3NhZ2UgPSBGQUxTRX0KbGlicmFyeShnZ3Bsb3QyKQpsaWJyYXJ5KGRwbHlyKQpsaWJyYXJ5KHBsb3RseSkKCiMgV2hhdCdzIGluIHRoaXMgUmRhdGEgZmlsZTogc2F2ZShjYV9jb252ZXJzaW9uX2ZhY3RvciwgY2FfZm9vZF9jaG9pY2VzLCBjYV9mb29kX2dyb3VwLCBjYV9mb29kX25hbWUsIGNhX2Zvb2Rfc291cmNlLCBjYV9tZWFzdXJlX25hbWUsIGNhX251dHJpZW50X2Ftb3VudCwgY2FfbnV0cmllbnRfbmFtZSwgY2FfbnV0cmllbnRfc291cmNlLCBjYV9yZWZ1c2VfYW1vdW50LCBjYV9yZWZ1c2VfbmFtZSwgY2FfeWllbGRfYW1vdW50LCBjYV95aWVsZF9uYW1lLCBkYWlseV92YWx1ZSwgZmlsZSA9ICJudXRyaWVudF9kYXRhLlJkYXRhIikKCmxvYWQoIi4uL2RhdGEvbnV0cmllbnRfZGF0YS5SZGF0YSIpCmBgYAoKIyBXZSd2ZSBnb3Qgb3VyIGRhdGEgbG9hZGVkLCBub3cgd2hhdCBkbyB3ZSB3YW50IHRvIGtub3c/CgpgYGB7ciBleHBsb3JlIHRoZSBzdHJ1Y3R1cmUgb2YgdGhlIGRhdGEgYSBiaXQsIG1lc3NhZ2UgPSBGQUxTRX0KCmNhX2Zvb2RfZ3JvdXAKaGVhZChjYV9mb29kX25hbWUpCgpgYGAKCiMgV2hhdCBkbyBteSBkYWlseSBjb2ZmZWUgbWFjcm9zIGxvb2sgbGlrZT8KYGBge3Igd2hhdCBkbyBteSBkYWlseSBjb2ZmZWUgbWFjcm9zIGxvb2sgbGlrZSwgbWVzc2FnZSA9IEZBTFNFfQoKI0knbGwgbmVlZCB0aGUgaW5ncmVkaWVudHMsIHRoZSBhbW91bnRzLCBhbmQgdGhlaXIgcmVzcGVjdGl2ZSBtYWNyb251dHJpZW50cwptZWFzdXJlX2RmIDwtIGNhX2Zvb2RfbmFtZSAlPiUKICBmaWx0ZXIoRm9vZERlc2NyaXB0aW9uID09ICJDb2ZmZWUsIGJyZXdlZCwgcHJlcGFyZWQgd2l0aCB0YXAgd2F0ZXIiKSAlPiUgCiAgc2VsZWN0KEZvb2RJRCkgJT4lCiAgbGVmdF9qb2luKGNhX2NvbnZlcnNpb25fZmFjdG9yKSAlPiUgCiAgbGVmdF9qb2luKGNhX21lYXN1cmVfbmFtZSkgJT4lIAogIHNlbGVjdChudW1lcmljLCB1bml0cywgZGVzY3JpcHRpb24sIENvbnZlcnNpb25GYWN0b3JWYWx1ZSwgTWVhc3VyZUlELCBGb29kSUQpIAoKbWVhc3VyZV9mb29kX2RmIDwtIG1lYXN1cmVfZGYgJT4lCiAgZmlsdGVyKG51bWVyaWMgPT0gMjUwKSAlPiUKICAgICAgbGVmdF9qb2luKGNhX251dHJpZW50X2Ftb3VudCkgJT4lCiAgICAgIGxlZnRfam9pbihjYV9udXRyaWVudF9uYW1lKSAlPiUKICAgICAgbXV0YXRlKE51dHJpZW50TmFtZSA9IHRvbG93ZXIoTnV0cmllbnROYW1lKSkgJT4lCiAgICAgIG11dGF0ZShOdXRyaWVudFZhbHVlID0gTnV0cmllbnRWYWx1ZSAqIENvbnZlcnNpb25GYWN0b3JWYWx1ZSAqIDI1MCAvIG51bWVyaWMpICU+JQogICAgc2VsZWN0KE51dHJpZW50TmFtZSwgTnV0cmllbnRWYWx1ZSwgTnV0cmllbnRJRCwgTnV0cmllbnRVbml0LCBDb252ZXJzaW9uRmFjdG9yVmFsdWUsIEZvb2RJRCkgJT4lIAogICAgICBncm91cF9ieShOdXRyaWVudE5hbWUpICU+JSAKICAgICAgc3VtbWFyaXplKFZhbHVlID0gcm91bmQoc3VtKE51dHJpZW50VmFsdWUsIG5hLnJtID0gVCksIGRpZ2l0cyA9IDIpLAogICAgICAgICAgICAgICAgVW5pdCA9IE51dHJpZW50VW5pdCwKICAgICAgICAgICAgICAgIE51dHJpZW50SUQgPSBOdXRyaWVudElEKQogIApzZWxlY3RfbnV0cmllbnRzIDwtIGMoImNhbGNpdW0iLCAiY2FyYm9oeWRyYXRlLCB0b3RhbCAoYnkgZGlmZmVyZW5jZSkiLCAiY2hvbGVzdGVyb2wiLCAiZW5lcmd5IChraWxvY2Fsb3JpZXMpIiwgImZhdCAodG90YWwgbGlwaWRzKSIsICJmYXR0eSBhY2lkcywgc2F0dXJhdGVkLCB0b3RhbCIsICJmYXR0eSBhY2lkcywgdHJhbnMsIHRvdGFsIiwgImZpYnJlLCB0b3RhbCBkaWV0YXJ5IiwgImlyb24iLCAicHJvdGVpbiIsICJyZXRpbm9sIGFjdGl2aXR5IGVxdWl2YWxlbnRzIiwgInNvZGl1bSIsICJzdWdhcnMsIHRvdGFsIiwgInZpdGFtaW4gYyIpCiAgIAptYWNyb19kZiA8LSBtZWFzdXJlX2Zvb2RfZGYgJT4lIGZpbHRlcihOdXRyaWVudE5hbWUgJWluJSBzZWxlY3RfbnV0cmllbnRzKSAlPiUKICBzZWxlY3QoTnV0cmllbnROYW1lLCBOdXRyaWVudElELCBWYWx1ZSwgVW5pdCkgJT4lCiAgYXJyYW5nZSgtVmFsdWUpCgpzY2FsZWRfbWFjcm9fZGYgPC0gZGFpbHlfdmFsdWUgJT4lIAogIGxlZnRfam9pbihtYWNyb19kZikgJT4lCiAgZmlsdGVyKEdyb3VwID09ICJtYWNyb251dHJpZW50cyIpICU+JQogIG11dGF0ZShTY2FsZWRfZHYgPSByb3VuZChWYWx1ZS9EViwgZGlnaXRzID0gMykgKiAxMDApICU+JQogIG5hLm9taXQoKQogIAojbG9vayBhdCBvdXIgZGF0YWZyYW1lCnNjYWxlZF9tYWNyb19kZgoKI2dldCByaWQgb2YgZnVua3kgdW5pdCBuYW1lIHRoYXQgY2F1c2VzIGlzc3VlcwpzY2FsZWRfbWFjcm9fZGZbc2NhbGVkX21hY3JvX2RmJFVuaXQgPT0gIlx4YjVnIiwgIlVuaXQiXSA8LSAiZyIKICAKbnV0cmllbnRfcGxvdCA8LSBnZ3Bsb3Qoc2NhbGVkX21hY3JvX2RmKSArCiAgZ2VvbV9iYXIoc3RhdCA9ICJpZGVudGl0eSIsIGFlcyh4ID0gcmVvcmRlcihOdXRyaWVudE5hbWUsIFNjYWxlZF9kdiksIFNjYWxlZF9kdikpICsKICB4bGFiKCJOdXRyaWVudCBuYW1lIikgKwogIHlsYWIoIiUgRGFpbHkgdmFsdWUiKSArCiAgY29vcmRfZmxpcCgpCgpudXRyaWVudF9wbG90CgojaW50ZXJhY3RpdmUgdmVyc2lvbiBvZiB0aGUgcGxvdCB3aXRoIHRoZSB2YWx1ZSBhcyBhIGhvdmVyaW5nIHRvb2x0aXAKZ2dwbG90bHkobnV0cmllbnRfcGxvdCwgdG9vbHRpcCA9ICJ5IikKCmBgYAoKIyBXaGF0IGRvZXMgbXkgZGFpbHkgY29mZmVlIG1pbmVyYWwgaW50YWtlIGxvb2sgbGlrZT8KYGBge3Igd2hhdCBkb2VzIG15IGRhaWx5IGNvZmZlZSBtaW5lcmFsIGludGFrZSBsb29rIGxpa2UsIG1lc3NhZ2UgPSBGQUxTRX0KCnNjYWxlZF9taW5lcmFsX2RmIDwtIGRhaWx5X3ZhbHVlICU+JSAKICBsZWZ0X2pvaW4obWFjcm9fZGYpICU+JQogIGZpbHRlcihHcm91cCA9PSAibWluZXJhbCIpICU+JQogIG11dGF0ZShTY2FsZWRfZHYgPSByb3VuZChWYWx1ZS9EViwgZGlnaXRzID0gMykgKiAxMDApICU+JQogIG5hLm9taXQoKQogIAojbG9vayBhdCBvdXIgZGF0YWZyYW1lCnNjYWxlZF9taW5lcmFsX2RmCgojZ2V0IHJpZCBvZiBmdW5reSB1bml0IG5hbWUgdGhhdCBjYXVzZXMgaXNzdWVzCnNjYWxlZF9taW5lcmFsX2RmW3NjYWxlZF9taW5lcmFsX2RmJFVuaXQgPT0gIlx4YjVnIiwgIlVuaXQiXSA8LSAiZyIKICAKbWluZXJhbF9wbG90IDwtIGdncGxvdChzY2FsZWRfbWluZXJhbF9kZikgKwogIGdlb21fYmFyKHN0YXQgPSAiaWRlbnRpdHkiLCBhZXMoeCA9IHJlb3JkZXIoTnV0cmllbnROYW1lLCBTY2FsZWRfZHYpLCBTY2FsZWRfZHYpKSArCiAgeGxhYigiTWluZXJhbCBuYW1lIikgKwogIHlsYWIoIiUgRGFpbHkgdmFsdWUiKSArCiAgY29vcmRfZmxpcCgpCgptaW5lcmFsX3Bsb3QKCiNpbnRlcmFjdGl2ZSB2ZXJzaW9uIG9mIHRoZSBwbG90IHdpdGggdGhlIHZhbHVlIGFzIGEgaG92ZXJpbmcgdG9vbHRpcApnZ3Bsb3RseShtaW5lcmFsX3Bsb3QsIHRvb2x0aXAgPSAieSIpCgpgYGAKCkFsbCByaWdodCwgc28gd2UndmUgdXNlZCB0aGUgSGVhbHRoIENhbmFkYSBkYXRhc2V0IHRvIHByb2R1Y2Ugc29tZSB0YWJsZXMgYW5kIHBsb3RzIGZvciBudXRyaWVudCBpbmZvIHBlcnRhaW5pbmcgdG8gYSBzZXJ2aW5nIG9mIGNvZmZlZS4gVGhlIGNvZGUgd29ya3MsIGJ1dCBhcmUgd2UgcmVhbGx5IGp1c3QgZ29pbmcgdG8gY29weSBhbmQgcGFzdGUgdGhlIGl0IGZvciBldmVyeSBmb29kIGluZ3JlZGllbnQgd2Ugd2FudCB0byBrbm93IGFib3V0PyAKCk1heWJlIHdlIGNvdWxkIHdyYXAgb3VyIGNvZGUgaW4gYSBmdW5jdGlvbiB0aGF0IHRha2VzIHRoZSBmb29kIG5hbWUgYXMgaW5wdXQgYW5kIHJldHVybnMgYWxsIG9mIG91ciB0YWJsZXMgYW5kIGZpZ3VyZXMuIFdoYXQgZG8gd2UgZG8gaWYgd2Ugd2FudCB0byBhZGQgbXVsdGlwbGUgaW5ncmVkaWVudHMgdG9nZXRoZXIsIHRob3VnaD8gSXQncyBjbGVhciB0aGF0IG91ciBub3RlYm9vayBhcHByb2FjaCB0byB0aGlzIGRhdGFzZXQgZG9lc24ndCByZWFsbHkgc2NhbGUgd2VsbC4gVGhpcyBpcyB3aGVyZSBTaGlueSBjb21lcyBpbiB0byBwbGF5LiBXZSBjYW4gcmVwbGFjZSB0aGUgaGFyZC1jb2RlZCBpbmdyZWRpZW50IHRleHQgdGhhdCB3aXRoIGFuIGFjdGl2ZSBpbnB1dCB0aGF0IHVwZGF0ZXMgb3VyIHBsb3RzIGFuZCB0YWJsZXMgd2hlbiB3ZSBjaGFuZ2Ugb3VyIGluZ3JlZGllbnQuCg==